add a finalizer to streamLogFile

Sponsored-by: Dartmouth College's DANDI project

diff --git a/Logs/File.hs b/Logs/File.hs
index be6aa72d15e0b5367e9f35f52102f1added16430..87e479ae7c3b5e96e313a266d55e7b1adabae04f 100644 (file)
--- a/Logs/File.hs
+++ b/Logs/File.hs
@@ -113,25 +113,30 @@ fullLines = go []
                        let (l, b') = L.splitAt n b
                        in go (l:c) (L.drop 1 b')
 
--- | Streams lines from a log file, and then empties the file at the end.
+-- | Streams lines from a log file, passing each line to the processor,
+-- and then empties the file at the end.
 --
--- If the action is interrupted or throws an exception, the log file is
+-- If the processor is interrupted or throws an exception, the log file is
 -- left unchanged.
 --
--- Does nothing if the log file does not exist.
+-- There is also a finalizer, that is run once all lines have been
+-- streamed. It is run even if the log file does not exist. If the
+-- finalizer throws an exception, the log file is left unchanged.
 -- 
 -- Locking is used to prevent writes to to the log file while this
 -- is running.
-streamLogFile :: FilePath -> RawFilePath -> (String -> Annex ()) -> Annex ()
-streamLogFile f lck a = withExclusiveLock lck $ bracketOnError setup cleanup go
+streamLogFile :: FilePath -> RawFilePath -> Annex () -> (String -> Annex ()) -> Annex ()
+streamLogFile f lck finalizer processor = 
+       withExclusiveLock lck $ bracketOnError setup cleanup go
   where
        setup = liftIO $ tryWhenExists $ openFile f ReadMode 
        cleanup Nothing = noop
        cleanup (Just h) = liftIO $ hClose h
-       go Nothing = noop
+       go Nothing = finalizer
        go (Just h) = do
-               mapM_ a =<< liftIO (lines <$> hGetContents h)
+               mapM_ processor =<< liftIO (lines <$> hGetContents h)
                liftIO $ hClose h
+               finalizer
                liftIO $ writeFile f ""
                setAnnexFilePerm (toRawFilePath f)
 

diff --git a/Logs/Smudge.hs b/Logs/Smudge.hs
index 9cde95a1d98f7f4f925aed9dea73aef7e78f613a..7b0f5ff5f6a6faaafef91d0f7188e29875670c4b 100644 (file)
--- a/Logs/Smudge.hs
+++ b/Logs/Smudge.hs
@@ -34,7 +34,7 @@ streamSmudged :: (Key -> TopFilePath -> Annex ()) -> Annex ()
 streamSmudged a = do
        logf <- fromRepo gitAnnexSmudgeLog
        lckf <- fromRepo gitAnnexSmudgeLock
-       streamLogFile (fromRawFilePath logf) lckf $ \l -> 
+       streamLogFile (fromRawFilePath logf) lckf noop $ \l -> 
                case parse l of
                        Nothing -> noop
                        Just (k, f) -> a k f